home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 1 / Cream of the Crop 1.iso / PROGRAM / GAUGE.ARJ / GAUGE.PAS < prev    next >
Pascal/Delphi Source File  |  1992-01-28  |  17KB  |  671 lines
  1. {$N+}
  2. {$R GAUGE}
  3.  
  4. program Gauge;
  5. uses
  6.   WinTypes, WinProcs, WinDOS, Strings;
  7.  
  8. const
  9.   ids_FSpace = 101;    (* Free Disk Space Static Control *)
  10.   ids_TSpace = 102;    (* Total Disk Space Static Control *)
  11.   ids_FMem   = 103;    (* Free Memory Static Control *)
  12.   ids_FRes   = 104;    (* Free System Resources Static Control *)
  13.   ids_Date   = 105;    (* Date Static Control *)
  14.   ids_Time   = 106;    (* Time Static Control *)
  15.  
  16.   ids_DriveText = 120; (* Text rectangle for Drive Space *)
  17.  
  18.   idc_Drives = 107;    (* Drive Selection Combo Box *)
  19.  
  20.   idr_DSpace = 108;    (* Disk Space Radio Button *)
  21.   idr_Memory = 109;    (* Memory Radio Button *)
  22.   idr_SysRes = 110;    (* System Resources Radio Button *)
  23.   idr_Time   = 111;    (* Time Radio Button *)
  24.   idr_Date   = 112;    (* Date Radio Button *)
  25.  
  26.   idb_OK     = 113;    (* OK Push Button *)
  27.  
  28.   ida_OK     = 100;
  29.  
  30.   idm_About  = 200;
  31.  
  32.   id_Timer = 1;
  33.  
  34.   tDiskRect : TRect = (left : 125; top : 15; right : 375; bottom : 35);
  35.  
  36.   avMem      : PChar = Nil;
  37.   avResource : PChar = Nil;
  38.   theTime    : PChar = Nil;
  39.   theDate    : PChar = Nil;
  40.  
  41. type
  42.   DriveStr = array[0..2] of Char;
  43.   DriveRec = Record
  44.     dLetter : DriveStr;
  45.     dTotal  : LongInt;
  46.   end;
  47.  
  48. var
  49.   avDiskRect : TRect;
  50.   curChoice,
  51.   lastDrive,
  52.   curDrive   : Integer;
  53.   avDrives   : array[0..23] of DriveRec;
  54.   sDate      : array[0..1] of Char;
  55.   sTime      : array[0..1] of Char;
  56.   sAMPM      : array[0..1, 0..4] of Char;
  57.   psAMPM     : array[0..1] of String;
  58.   iDate,
  59.   iTime      : Integer;
  60.   dChoice    : Integer;
  61.  
  62. (* -------------  Undocumented Windows function ---------------- *)
  63.  
  64. function GetHeapSpaces(hModule : THandle) : LongInt; far;
  65. external 'KERNEL' index 138;
  66.  
  67. (* ------------------------------------------------------------- *)
  68.  
  69. function AboutDlgProc(hDlg : hWnd; message, wParam : Word;
  70.                       lParam : LongInt) : Bool; Export;
  71.   begin
  72.     AboutDlgProc := True;
  73.     case message of
  74.       wm_InitDialog :
  75.         begin
  76.           Exit;
  77.         end;
  78.  
  79.       wm_Command :
  80.         begin
  81.           case wParam of
  82.             ida_OK :
  83.               begin
  84.                 EndDialog(hDlg, 0);
  85.                 Exit;
  86.               end;
  87.           end;
  88.         end;
  89.     end;
  90.     AboutDlgProc := False;
  91.   end;
  92.  
  93.  
  94. function min(x, y : Word) : Word;
  95. begin
  96.     if x > y then
  97.        min := y
  98.   else
  99.        min := x;
  100. end;
  101.  
  102.  
  103. function OneDriveInfo(drive : Integer; var total : LongInt) : Boolean;
  104.   var
  105.     dType : Word;
  106.   begin
  107.     OneDriveInfo := False;
  108.     total := 0;
  109.  
  110.     dType := GetDriveType(drive - 1);
  111.     if (dType = drive_Fixed) or (dType = drive_Removable) then begin
  112.       OneDriveInfo := True;
  113.       if dType <> drive_Remote then
  114.         total := DiskSize(drive) div 1024 div 1024;
  115.     end;
  116.   end;
  117.  
  118.  
  119.  
  120. function GetDriveInfo : Integer;
  121.   var
  122.     i, j  : Integer;
  123.     Total : LongInt;
  124.     isOK  : Boolean;
  125.   begin
  126.     i := 3;
  127.     j := -1;
  128.     isOK := True;
  129.     while isOK do begin
  130.       isOK := OneDriveInfo(i, Total);
  131.       if isOK then begin
  132.         if (Total <> 0) then begin
  133.           Inc(j);
  134.           with avDrives[j] do begin
  135.             dTotal := Total;
  136.  
  137.             dLetter[0] := Chr(i + 64);
  138.             dLetter[1] := ':';
  139.           end;
  140.           Inc(i);
  141.         end
  142.         else
  143.           isOK := False;
  144.       end;
  145.     end;
  146.     GetDriveInfo := j;
  147.   end;
  148.  
  149. function GetFreeMemory : String;
  150.   var
  151.     dwFreeMem : LongInt;
  152.     curMem,
  153.     rMem      : Real;
  154.     temp      : String;
  155.   begin
  156.     dwFreeMem := GetFreeSpace(0);
  157.     curMem := dwFreeMem;
  158.     rMem := curMem / 1024.0 / 1024.0;
  159.     Str(rMem:5:2, temp);
  160.     GetFreeMemory := Concat(temp, ' Mb');
  161.   end;
  162.  
  163. procedure heapInfo(module : PChar; var pfree, ptotal, ppercent : Word);
  164.   var
  165.     info : LongInt;
  166.   begin
  167.     info := GetHeapSpaces(GetModuleHandle(module));
  168.     pfree := LoWord(info);
  169.     ptotal := Hiword(info);
  170.     info := Word((LongInt(pfree) * 100) div ptotal);
  171.     ppercent := info;
  172.   end;
  173.  
  174. function GetFreeResources : LongInt;
  175.   var
  176.     userFree,
  177.     userTotal,
  178.     userPercent,
  179.     gdiFree,
  180.     gdiTotal,
  181.     gdiPercent : Word;
  182.   begin
  183.     heapInfo('USER', userFree, userTotal, userPercent);
  184.     heapInfo('GDI', gdiFree, gdiTotal, gdiPercent);
  185.     (*GetFreeResources := min(userPercent, gdiPercent);*)
  186.     GetFreeResources := MakeLong(userPercent, gdiPercent);
  187.   end;
  188.  
  189.  
  190. procedure SetInternational;
  191.   const
  192.     cName = 'intl';
  193.   begin
  194.     iDate := GetProfileInt(cName, 'iDate', 0);
  195.     iTime := GetProfileInt(cName, 'iTime', 0);
  196.  
  197.     GetProfileString(cName, 'sDate', '/', sDate,     2);
  198.     GetProfileString(cName, 'sTime', ':', sTime,     2);
  199.     GetProfileString(cName, 's1159', 'AM', sAMPM[0], 5);
  200.     GetProfileString(cName, 's2359', 'PM', sAMPM[1], 5);
  201.     psAMPM[0] := StrPas(sAMPM[0]);
  202.     psAMPM[1] := StrPas(sAMPM[1]);
  203.   end;
  204.  
  205. procedure ModifyText(var hh : String);
  206.   begin
  207.     if hh[1] = ' ' then
  208.       hh[1] := '0';
  209.   end;
  210.  
  211. function GetCurTime : String;
  212.   var
  213.     hr,
  214.     min,
  215.     sec,
  216.     hsec  : Word;
  217.     temp,
  218.     shour,
  219.     smin  : String;
  220.   begin
  221.     GetTime(hr, min, sec, hsec);
  222.     Str(hr:2, shour);
  223.     Str(min:2, smin);
  224.     ModifyText(shour);
  225.     ModifyText(smin);
  226.     if iTime = 1 then
  227.       temp := Concat(shour, sTime[0], smin)
  228.     else begin
  229.       if (hr mod 12) <> 0 then
  230.         Str(hr mod 12:2, shour)
  231.       else
  232.         shour := '12';
  233.       temp:= Concat(shour, sTime[0], smin, ' ', psAMPM[hr div 12]);
  234.     end;
  235.     GetCurTime := temp;
  236.   end;
  237.  
  238. function GetCurDate : String;
  239.   var
  240.     yr,
  241.     mo,
  242.     day,
  243.     dweek   : Word;
  244.     temp,
  245.     smo,
  246.     syr,
  247.     sday    : String;
  248.   begin
  249.     GetDate(yr, mo, day, dweek);
  250.     Str(yr mod 100:2, syr);
  251.     Str(mo:2, smo);
  252.     Str(day:2, sday);
  253.     ModifyText(syr);
  254.     ModifyText(smo);
  255.     ModifyText(sday);
  256.     if iDate = 1 then
  257.       temp := Concat(sday, sDate[0], smo, sDate[0], syr)
  258.     else if iDate = 2 then
  259.       temp := Concat(syr, sDate[0], smo, sDate[0], sday)
  260.     else
  261.       temp := Concat(smo, sDate[0], sday, sDate[0], syr);
  262.     GetCurDate := temp;
  263.   end;
  264.  
  265. procedure SetupDlg(Window : HWnd);
  266.   var
  267.     curDir : PChar;
  268.   begin
  269.     GetMem(curDir, fsDirectory);
  270.     GetCurDir(curDir, 0);
  271.     curDrive := Ord(curDir[0]) - 67;
  272.     FreeMem(curDir, fsDirectory);
  273.  
  274.     SetInternational;
  275.     (* First, determine the available drives, skipping A: & B: *)
  276.     lastDrive := GetDriveInfo;
  277.  
  278.     curChoice := idr_DSpace;
  279.  
  280.     CheckRadioButton(Window, idr_DSpace, idr_Date, curChoice);
  281.   end;
  282.  
  283.  
  284. procedure GetAvail(theDrive : Integer; total : LongInt;
  285.                    var avail : LongInt; var ratio : Single);
  286.   begin
  287.     avail := DiskFree(theDrive + 3) div 1024 div 1024;
  288.     ratio := Single(avail) / Single(total);
  289.   end;
  290.  
  291. procedure WndPaint(Window : HWnd; aDC : HDC);
  292.   const
  293.      dAdded : Boolean = False;
  294.   var
  295.     noDC   : Boolean;
  296.     ps     : TPaintStruct;
  297.     buffer : array[0..20] of Char;
  298.     temp   : Single;
  299.     tInt   : LongInt;
  300.     oldBrush,
  301.     redBrush : HBrush;
  302.     i       : Integer;
  303.     theErr  : LongInt;
  304.     avSpace : LongInt;
  305.     dRatio  : Single;
  306.     oldColor : LongInt;
  307.   begin
  308.     if aDC = 0 then
  309.       begin
  310.           aDC := GetDC(Window);
  311.         noDC := True;
  312.       end
  313.     else
  314.       noDC := False;
  315.  
  316.     GetAvail(curDrive, avDrives[curDrive].dTotal, avSpace, dRatio);
  317.  
  318.     with tDiskRect do
  319.       Rectangle(aDC, left, top, right, bottom);
  320.  
  321.     with avDiskRect do begin
  322.       left := tDiskRect.left;
  323.       top := tDiskRect.top;
  324.       bottom := tDiskRect.bottom;
  325.       tInt := tDiskRect.right - tDiskRect.left;
  326.       temp := Single(tInt) * dRatio;
  327.       right := LongInt(temp) + left;
  328.     end;
  329.  
  330.     redBrush := CreateSolidBrush(RGB(255, 0, 0));
  331.     oldBrush := SelectObject(aDC, redBrush);
  332.  
  333.     with avDiskRect do
  334.       Rectangle(aDC, left, top, right, bottom);
  335.  
  336.     SelectObject(aDC, oldBrush);
  337.     DeleteObject(redBrush);
  338.  
  339.     wvsprintf(buffer, '%lu Mb', avSpace);
  340.     SetDlgItemText(Window, ids_FSpace, buffer);
  341.     wvsprintf(buffer, '%lu Mb', avDrives[curDrive].dTotal);
  342.     SetDlgItemText(Window, ids_TSpace, buffer);
  343.  
  344.  
  345.     if avMem <> Nil then
  346.       FreeMem(avMem, 10);
  347.     GetMem(avMem, 10);
  348.     StrPCopy(avMem, GetFreeMemory);   (* get memory *)
  349.  
  350.     theErr := GetFreeResources;          (* LoWord = user, HiWord = GDI *)
  351.     if avResource <> Nil then
  352.       FreeMem(avResource, 25);
  353.     GetMem(avResource, 25);
  354.     wvsprintf(avResource, '%2u%% User   %2u%% GDI', theErr);
  355.  
  356.     if theTime <> Nil then
  357.       FreeMem(theTime, 15);
  358.     GetMem(theTime, 15);
  359.     StrPCopy(theTime, GetCurTime);
  360.  
  361.     if theDate <> Nil then
  362.       FreeMem(theDate, 15);
  363.     GetMem(theDate, 15);
  364.     StrPCopy(theDate, GetCurDate);
  365.  
  366.     SetDlgItemText(Window, ids_FMem, avMem);
  367.     SetDlgItemText(Window, ids_FRes, avResource);
  368.     SetDlgItemText(Window, ids_Date, theDate);
  369.     SetDlgItemText(Window, ids_Time, theTime);
  370.  
  371.     CheckRadioButton(Window, idr_DSpace, idr_Date, curChoice);
  372.  
  373.     if (not dAdded) then begin
  374.        for i := 0 to lastDrive do
  375.          theErr := SendDlgItemMessage(Window, idc_Drives, lb_AddString,
  376.                                       0, LongInt(@avDrives[i].dLetter));
  377.        dAdded := True;
  378.     end;
  379.     theErr := SendDlgItemMessage(Window, idc_Drives, lb_SetCurSel,
  380.                                             curDrive, 0);
  381.  
  382.     if (noDC) then
  383.       ReleaseDC(Window, aDC);
  384.   end;
  385.  
  386.  
  387. procedure DrawDrive(Window : HWnd; aDC : HDC; Rect : TRect);
  388.   var
  389.     aRect    : TRect;
  390.     oldBrush,
  391.     aBrush   : HBrush;
  392.     tInt     : LongInt;
  393.     temp     : Single;
  394.     oldMode  : Integer;
  395.     oldAlign : Word;
  396.     avSpace  : LongInt;
  397.     dRatio   : Single;
  398.   begin
  399.     GetAvail(curDrive, avDrives[curDrive].dTotal, avSpace, dRatio);
  400.  
  401.     with aRect do begin
  402.       left := Rect.left;
  403.       right := Rect.right;
  404.       top := Rect.top;
  405.       tInt := Rect.bottom;
  406.       temp := Single(tInt) * dRatio;
  407.       bottom := LongInt(temp);
  408.     end;
  409.     aBrush := CreateSolidBrush(RGB(255, 0, 0));
  410.     oldBrush := SelectObject(aDC, aBrush);
  411.     with aRect do
  412.        Rectangle(aDC, left, top, right, bottom);
  413.     SelectObject(aDC, oldBrush);
  414.     DeleteObject(aBrush);
  415.  
  416.     oldMode := SetBkMode(aDC, Transparent);
  417.     TextOut(aDC, Rect.left + 10, Rect.top + 10, avDrives[curDrive].dLetter,
  418.             strlen(avDrives[curDrive].dLetter));
  419.     SetBkMode(aDC, oldMode);
  420.   end;
  421.  
  422. procedure DrawMemory(Window : HWnd; aDC : HDC; Rect : TRect);
  423.   var
  424.     oldMode  : Integer;
  425.   begin
  426.     if avMem <> Nil then
  427.       FreeMem(avMem, 10);
  428.     GetMem(avMem, 10);
  429.     StrPCopy(avMem, GetFreeMemory);   (* get memory *)
  430.  
  431.     oldMode := SetBkMode(aDC, Transparent);
  432.     DrawText(aDC, avMem, strlen(avMem), Rect, dt_WordBreak);
  433.     SetBkMode(aDC, oldMode);
  434.   end;
  435.  
  436. procedure DrawSysRes(Window : HWnd; aDC : HDC; Rect : TRect);
  437.   var
  438.     oldMode : Integer;
  439.     lRes    : LongInt;
  440.     tWord   : Word;
  441.   begin
  442.     lRes := GetFreeResources;  (* get free resources *)
  443.     tWord := min(LoWord(lRes), HiWord(lRes));
  444.     if avResource <> Nil then
  445.       FreeMem(avResource, 25);
  446.     GetMem(avResource, 25);
  447.     wvsprintf(avResource, '%2u%% Avail', tWord);
  448.  
  449.     oldMode := SetBkMode(aDC, Transparent);
  450.     DrawText(aDC, avResource, strlen(avResource), Rect, dt_WordBreak);
  451.     SetBkMode(aDC, oldMode);
  452.   end;
  453.  
  454. procedure DrawTime(Window : HWnd; aDC : HDC; Rect : TRect);
  455.   var
  456.     oldMode  : Integer;
  457.   begin
  458.     if theTime <> Nil then
  459.       FreeMem(theTime, 15);
  460.     GetMem(theTime, 15);
  461.     StrPCopy(theTime, GetCurTime);
  462.  
  463.     oldMode := SetBkMode(aDC, Transparent);
  464.     DrawText(aDC, theTime, strlen(theTime), Rect, dt_WordBreak);
  465.     SetBkMode(aDC, oldMode);
  466.   end;
  467.  
  468. procedure DrawDate(Window : HWnd; aDC : HDC; Rect : TRect);
  469.   var
  470.     oldMode  : Integer;
  471.   begin
  472.     if theDate <> Nil then
  473.       FreeMem(theDate, 15);
  474.     GetMem(theDate, 15);
  475.     StrPCopy(theDate, GetCurDate);
  476.  
  477.     oldMode := SetBkMode(aDC, Transparent);
  478.     DrawText(aDC, theDate, strlen(theDate), Rect, dt_WordBreak);
  479.     SetBkMode(aDC, oldMode);
  480.   end;
  481.  
  482.  
  483. procedure IconPaint(Window : HWnd; aDC : HDC);
  484.   var
  485.     theRect : TRect;
  486.     oldBrush,
  487.     aBrush  : HBrush;
  488.   begin
  489.     GetClientRect(Window, theRect);
  490.     aBrush := CreateSolidBrush(RGB(255, 255, 255));
  491.     oldBrush := SelectObject(aDC, aBrush);
  492.  
  493.     with theRect do
  494.       Rectangle(aDC, left, top, right, bottom);
  495.     SelectObject(aDC, oldBrush);
  496.     DeleteObject(aBrush);
  497.  
  498.     case curChoice of
  499.       idr_DSpace : DrawDrive(Window, aDC, theRect);
  500.       idr_Memory : DrawMemory(Window, aDC, theRect);
  501.       idr_SysRes : DrawSysRes(Window, aDC, theRect);
  502.       idr_Time   : DrawTime(Window, aDC, theRect);
  503.       idr_Date   : DrawDate(Window, aDC, theRect);
  504.     end;
  505.   end;
  506.  
  507.  
  508. function WndProc(Window : hWnd; Message, wParam : word;
  509.             lParam : Longint) : Longint; export;
  510.   const
  511.     hInst            : THandle = 0;
  512.     lpfnAboutDlgProc : TFarProc = Nil;
  513.     ctlBrush : HBrush = 0;
  514.   var
  515.     aDC     : HDC;
  516.     ps      : TPaintStruct;
  517.     hControl : HWnd;
  518.   begin
  519.     WndProc := 0;
  520.     case Message of
  521.         wm_Create :
  522.           begin
  523.             hInst := GetWindowWord(Window, gww_hInstance);
  524.             lpfnAboutDlgProc := MakeProcInstance(@AboutDlgProc, hInst);
  525.             ctlBrush := CreateSolidBrush(RGB(255, 0, 0));
  526.  
  527.             SetUpDlg(Window);
  528.             Exit;
  529.           end;
  530.  
  531.         wm_CtlColor :
  532.           begin
  533.             if (GetDlgCtrlId(LoWord(lParam)) = ids_FSpace) then
  534.               if (HiWord(lParam) = ctlcolor_Static) then begin
  535.                 SetBkColor(wParam, RGB(255, 0, 0));
  536.                 SetTextColor(wParam, RGB(255, 255, 255));
  537.                 WndProc := LongInt(ctlBrush);
  538.                 Exit;
  539.               end
  540.           end;
  541.  
  542.         wm_SysCommand :
  543.           begin
  544.             if wParam = idm_About then begin
  545.               DialogBox(hInst, 'AboutBox', Window, lpfnAboutDlgProc);
  546.  
  547.               Exit;
  548.             end;
  549.           end;
  550.  
  551.         wm_Timer :
  552.           begin
  553.             if (isIconic(Window)) then
  554.               InvalidateRect(Window, Nil, True)
  555.             else
  556.               WndPaint(Window, 0);
  557.             Exit;
  558.           end;
  559.  
  560.         wm_Paint :
  561.           begin
  562.             aDC := BeginPaint(Window, ps);
  563.             if (isIconic(Window)) then
  564.               IconPaint(Window, aDC)
  565.             else
  566.               WndPaint(Window, aDC);
  567.  
  568.             EndPaint(Window, ps);
  569.             Exit;
  570.           end;
  571.  
  572.         wm_Command :
  573.           begin
  574.             case wParam of
  575.               idr_DSpace,
  576.               idr_Memory,
  577.               idr_SysRes,
  578.               idr_Time,
  579.               idr_Date   :
  580.                 begin
  581.                   curChoice := wParam;
  582.  
  583.                   CheckRadioButton(Window, idr_DSpace, idr_Date, wParam);
  584.                   Exit;
  585.                 end;
  586.  
  587.               idc_Drives :
  588.                 begin
  589.                   hControl := GetDlgItem(Window, idc_Drives);
  590.                   curDrive := SendMessage(hControl, lb_GetCurSel, 0, 0);
  591.                   WndPaint(Window, 0);
  592.  
  593.                   Exit;
  594.                 end;
  595.  
  596.               idb_OK :
  597.                 begin
  598.                   CloseWindow(Window);
  599.                   Exit;
  600.                 end;
  601.             end;  (* case *)
  602.           end;
  603.  
  604.         wm_Destroy:
  605.           begin
  606.             DeleteObject(ctlBrush);
  607.             KillTimer(Window, id_Timer);
  608.             PostQuitMessage(0);
  609.             Exit;
  610.           end;
  611.     end;   { case }
  612.     WndProc := DefWindowProc(Window, Message, wParam, lParam);
  613.   end;
  614.  
  615. procedure WinMain;
  616.   const
  617.     szAppName = 'Gauge';
  618.     WClass : TWndClass = (
  619.       Style          : cs_HRedraw or cs_VRedraw;
  620.       lpfnWndProc    : @WndProc;
  621.       cbClsExtra     : 0;
  622.       cbWndExtra     : DlgWindowExtra;
  623.       hInstance      : 0;
  624.       hIcon          : 0;
  625.       hCursor        : 0;
  626.       hbrBackground  : 0;
  627.       lpszMenuName   : nil;
  628.       lpszClassName  : szAppName);
  629.   var
  630.     Window   : HWnd;
  631.     msg      : TMsg;
  632.     aMenu    : HMenu;
  633.   begin
  634.     if (hPrevInst = 0) then begin
  635.       WClass.hInstance := hInstance;
  636.         WClass.hCursor := LoadCursor(0, idc_Arrow);
  637.         (*WClass.hbrBackground := GetStockObject(White_Brush);*)
  638.         WClass.hbrBackground := Color_Window + 1;
  639.         if not RegisterClass(WClass) then
  640.           Halt(255);
  641.     end;
  642.  
  643.  
  644.     Window := CreateDialog(hInstance, szAppName, 0, Nil);
  645.  
  646.     aMenu := GetSystemMenu(Window, False);
  647.  
  648.     AppendMenu(aMenu, mf_Separator, 0, Nil);
  649.     AppendMenu(aMenu, mf_String, idm_About, 'About...');
  650.     EnableMenuItem(aMenu, 2, mf_byPosition or mf_Grayed);
  651.     EnableMenuItem(aMenu, 4, mf_byPosition or mf_Grayed);
  652.  
  653.     if (SetTimer(Window, id_Timer, 10000, Nil) = 0) then begin
  654.       MessageBox(Window, 'Too many clocks or timers!',
  655.                 szAppName, mb_IconExclamation or mb_Ok);
  656.     end;
  657.  
  658.     ShowWindow(Window, CmdShow);
  659.  
  660.     while GetMessage(msg, 0, 0, 0) do begin
  661.       TranslateMessage(msg);
  662.       DispatchMessage(msg);
  663.     end;
  664.  
  665.     Halt(msg.wParam);
  666.   end;
  667.  
  668. begin
  669.   WinMain;
  670. end.
  671.